home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / util / text / xes.lha / XES / REXX / RenumberOutline.xdme < prev    next >
Text File  |  1995-08-01  |  3KB  |  137 lines
  1. /* $VER: RenumberOutline.xdme 1.0 (01 Aug 1995) */
  2. /* Copyright © 1995 Fergus Duniho */
  3. /* Renumbers Blocked Portion of an Outline */
  4.  
  5. 'goto end if b downadd'
  6. bsave 'ram:text'
  7. 'title `Renumbering -\Please Wait!'
  8. Call Open 'Old','RAM:TEXT','R'
  9. Call Open 'New','RAM:TEXT2','W'
  10.  
  11. Do X = 1 to 8
  12.     H.X = ''
  13. End
  14.  
  15. LINE = Readln('Old')
  16. Call Writeln 'New',LINE
  17. LN = 0
  18. POSITION = Verify(LINE,'.)',m)
  19. LV = (POSITION - 9)%4 + 1
  20. H.LV = Word(LINE,1)
  21.  
  22. DO FOREVER
  23.     DO UNTIL LINE = ''
  24.         LINE = Readln('Old')
  25.         CALL Writeln 'New',LINE
  26.         LN = LN + 1
  27.     END
  28.  
  29.     LINE = Readln('Old')
  30.     IF EOF('Old') THEN LEAVE
  31.     LN = LN + 1
  32.  
  33.     PS = Verify(LINE,'.)',m)
  34.     IF PS = 0 THEN LEAVE
  35.  
  36.     H.LV = Left(H.LV,Length(H.LV)-1)
  37.     LEVEL = LV
  38.  
  39.     LV = (PS - 9)%4 + 1
  40.     HD = Word(LINE,1)
  41.  
  42.     IF LEVEL >= LV THEN
  43.         IF H.LV ~= '' THEN DO
  44.             SELECT
  45.                 WHEN LV = 1 THEN H.LV = UPPER(Roman(Arabic(H.LV) + 1))
  46.                 WHEN LV = 2 | LV = 5 | LV = 8 THEN H.LV = d2c(c2d(H.LV) + 1)
  47.                 WHEN LV = 3 | LV = 6 THEN H.LV = H.LV + 1
  48.                 WHEN LV = 4 | LV = 7 THEN H.LV = (Roman(Arabic(H.LV) + 1))
  49.                 OTHERWISE NOP
  50.             END
  51.             H.LV = H.LV || Right(HD,1)
  52.         END
  53.         ELSE H.LV = HD
  54.     ELSE IF LEVEL = LV - 1 THEN DO
  55.         SELECT
  56.             WHEN LEVEL = 1 THEN H.LV = 'A.'
  57.             WHEN LEVEL = 2 THEN H.LV = '1.'
  58.             WHEN LEVEL = 3 THEN H.LV = 'i.'
  59.             WHEN LEVEL = 4 THEN H.LV = 'a.'
  60.             WHEN LEVEL = 5 THEN H.LV = '1)'
  61.             WHEN LEVEL = 6 THEN H.LV = 'i)'
  62.             WHEN LEVEL = 7 THEN H.LV = 'a)'
  63.             OTHERWISE NOP
  64.         END
  65.     END
  66.     ELSE DO
  67.         goto block
  68.         Com = 'goto +'LN
  69.         Com
  70.         firstnb
  71.         'set RS `Error !!!'
  72.         EXIT
  73.     END
  74.  
  75.     LINE = Copies(' ',Ps - (Length(H.LV))) || H.LV " " Subword(LINE, 2)
  76.     CALL Writeln 'New',LINE
  77. END
  78.  
  79. CALL Close ('Old')
  80. CALL Close ('New')
  81. bdelete
  82. 'set RS `Renumbering Successful'
  83. insfile 'ram:text2'
  84.  
  85. EXIT
  86.  
  87. /* Converts an Arabic Numeral to a Roman Numeral */
  88. Roman: Procedure
  89. ARG A
  90. R = word("i ii iii iv v vi vii viii ix",A//10)
  91. A = A % 10
  92.  
  93. IF A > 0 THEN DO
  94.     R = Word("x xx xxx xl l lx lxx lxxx xc",A//10) || R
  95.     A = A % 10
  96. END
  97.  
  98. IF A > 0 THEN DO
  99.     R = Word("c cc ccc cd d dc dcc dccc cm",A//10) || R
  100.     A = A % 10
  101. END
  102.  
  103. IF A > 0 THEN R = Word("m mm mmm",A) || R
  104.  
  105. RETURN R
  106.  
  107. /* Converts a Roman numeral to an Arabic numeral */
  108.  
  109. Arabic: Procedure
  110. Arg ROMAN
  111. A = 0
  112.  
  113. DO P = 1 to Length(ROMAN)
  114.     L = Substr(ROMAN,P,1)
  115.     R = Delstr(ROMAN,1,P)
  116.     SELECT
  117.         WHEN L = 'M' Then A = A + 1000
  118.         WHEN L = 'D' Then A = A + 500
  119.         WHEN L = 'C' Then If Verify(R,'MD','M')>0 THEN
  120.             A = A - 100
  121.         ELSE
  122.             A = A + 100
  123.         WHEN L = 'L' Then A = A + 50
  124.         WHEN L = 'X' Then If Verify(R,'CL','M')>0 THEN
  125.             A = A - 10
  126.         ELSE
  127.             A = A + 10
  128.         WHEN L = 'V' Then A = A + 5
  129.         WHEN L = 'I' Then If Verify(R,'XV','M')>0 THEN
  130.             A = A - 1
  131.         ELSE
  132.             A = A + 1
  133.         OTHERWISE NOP
  134.     END
  135. END
  136. RETURN A
  137.